home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / oper_sys / fp / ifp_unix.lzh / ifp / interp / infun.c < prev    next >
Encoding:
C/C++ Source or Header  |  1989-05-23  |  9.0 KB  |  386 lines
  1.  
  2. /****** infun.c *******************************************************/
  3. /**                                                                  **/
  4. /**                    University of Illinois                        **/
  5. /**                                                                  **/
  6. /**                Department of Computer Science                    **/
  7. /**                                                                  **/
  8. /**   Tool: IFP                         Version: 0.5                 **/
  9. /**                                                                  **/
  10. /**   Author:  Arch D. Robison          Date:   May 1, 1985          **/
  11. /**                                                                  **/
  12. /**   Revised by: Arch D. Robison       Date:   Aug 4, 1986          **/
  13. /**                                                                  **/
  14. /**   Principal Investigators: Prof. R. H. Campbell                  **/
  15. /**                            Prof. W. J. Kubitz                    **/
  16. /**                                                                  **/
  17. /**                                                                  **/
  18. /**------------------------------------------------------------------**/
  19. /**   (C) Copyright 1987  University of Illinois Board of Trustees   **/
  20. /**                       All Rights Reserved.                       **/
  21. /**********************************************************************/
  22.  
  23.  
  24. #include <stdio.h>
  25. #include <ctype.h>
  26. #include "struct.h"
  27. #include "node.h"
  28. #include "string.h"
  29. #include "inob.h"
  30.  
  31. /*
  32.  * PATTERN should be 0.  Setting it to 1 enables a parser extension
  33.  * for experimental compiler work.
  34.  */
  35. #define PATTERN 0
  36.  
  37. /*
  38.  * MakeForm
  39.  *
  40.  * If correct, create form with node N and function list Funs.
  41.  *
  42.  * Output
  43.  *      result = 1 if no error, 0 otherwise
  44.  */
  45. boolean MakeForm (Correct,N,Funs,InOut)
  46.    boolean Correct;
  47.    NodePtr N;
  48.    ListPtr Funs;
  49.    ObjectPtr InOut;
  50.    {
  51. #ifdef PARAMBUG        /* cure for CRAY C-compiler bug (see struct.h) */
  52. {
  53.       ListPtr T = Funs;
  54.       NewList (&T,1L);
  55.       Funs = T;
  56. }
  57. #else
  58.       NewList (&Funs,1L); 
  59. #endif
  60.       if (SysError || !Correct) {
  61.      DelLPtr (Funs);
  62.      return 0;
  63.       } else {
  64.      Funs->Val.Tag = NODE;
  65.      Funs->Val.Node = CopyNPtr (N);
  66.      RepTag (InOut,LIST);
  67.      InOut->List = Funs;
  68.      return 1;
  69.       }
  70.    }
  71.  
  72. /*
  73.  * InNext
  74.  *
  75.  * Input next composition, which should be followed by Token.
  76.  *
  77.  * Input
  78.  *      *F = input
  79.  *      End = pointer to MetaPtr to end of list.
  80.  *      Token = token expected.
  81.  *    K = pointer to entry of form being parsed 
  82.  */
  83. boolean InNext (F,End,Token,K,Env)
  84.    InDesc *F;
  85.    MetaPtr *End;
  86.    char *Token;
  87.    FormEntry *K;
  88.    ListPtr Env;
  89.    {
  90.       NewList (*End,1L);
  91.       if (SysError || !InComp (F,&(**End)->Val,Env)) return 0;
  92.       if (!IsTok (F,Token)) {
  93.      char Error [80];
  94.      (void) sprintf (Error,"'%s' part of '%s' expected",
  95.              Token,K->FormComment);
  96.      return InError (F,Error);
  97.       }
  98.       *End = &(**End)->Next;
  99.       return 1;
  100.    }
  101.  
  102. /*
  103.  * InPFO
  104.  *
  105.  * Input a PFO.
  106.  *
  107.  * Input
  108.  *     F = input descriptor pointing to 1st token after 1st keyword of form
  109.  *      K = index of form
  110.  *    Env = environment list
  111.  *
  112.  * Output
  113.  *    InOut = form
  114.  */
  115. private boolean InPFO (F,InOut,K,Env)
  116.    register InDesc *F;
  117.    ObjectPtr InOut;
  118.    FormEntry *K;
  119.    ListPtr Env;
  120.    {
  121.       ListPtr R = NIL;
  122.       MetaPtr A = &R;
  123.       boolean Correct;
  124.  
  125.       switch (K-FormTable) {
  126.      case NODE_If:
  127.         Correct = 0;
  128.         if (InNext (F,&A,"THEN",K,Env) && InNext (F,&A,"\0",K,Env))
  129.            if (IsTok (F,"ELSIF")) {
  130.           NewList (A,1L);
  131.           Correct = !SysError && InPFO (F,&(*A)->Val,K,Env);
  132.            } else
  133.           if (IsTok (F,"ELSE")) Correct = InNext (F,&A,"END",K,Env);
  134.           else (void) InError (F,"'ELSE' or 'ELSIF' expected");
  135.         break;
  136.  
  137.      case NODE_Each:
  138.      case NODE_RInsert:
  139.      case NODE_Filter:
  140.         Correct = InNext (F,&A,"END",K,NIL);
  141.         break;
  142.  
  143.      case NODE_While:
  144.         Correct = InNext (F,&A,"DO",K,NIL) && InNext (F,&A,"END",K,NIL);
  145.         break;
  146. #if XDEF
  147.      case NODE_XDef: {
  148.         ListPtr OldEnv = Env;
  149.         Correct = 0;
  150.         NewList (A,1L);
  151.         if (SysError || !InLHS (F,&(*A)->Val,&Env)) break;
  152.         if (!IsTok (F,":=")) (void) InError (F,"':=' expected");
  153.         else {
  154.            A = &(*A)->Next;
  155.            if (!InNext (F,&A,"}",K,OldEnv)) break;
  156.            NewList (A,1L);
  157.            if (InSimple (F,&(*A)->Val,Env)) Correct = 1;
  158.         }
  159.         break;
  160.      }
  161. #endif /* XDEF */
  162.  
  163.      case NODE_C:
  164.         NewList (A,1L);
  165.         if (Correct = !SysError && InObject (F,&(*A)->Val))
  166.            if ((*A)->Val.Tag == BOTTOM) {
  167.           /* Convert #? to #(null) */
  168.           DelLPtr (R);
  169.           R = NIL;
  170.           }
  171.         break;
  172.  
  173.      case NODE_Cons:
  174.         if (!(Correct = IsTok (F,"]"))) {
  175.            while ((Correct = InNext (F,&A,"\0",K,Env)) && IsTok (F,",")) 
  176.           continue;
  177.            if (Correct) 
  178.           if (Correct = IsTok (F,"]"));
  179.           else (void) InError (F,"']' or ',' expected");
  180.         }
  181.         break;
  182.  
  183. #if FETCH
  184.      case NODE_Fetch:
  185. #endif
  186.      case NODE_Out:
  187.         NewList (A,1L);
  188.         Correct = !SysError && InObject (F,&(*A)->Val);
  189.         break;
  190.  
  191.       }
  192.       return MakeForm (Correct,K->FormNode,R,InOut);
  193.    }
  194.  
  195. /*
  196.  * InSelector
  197.  *
  198.  * Input
  199.  *     F = input descriptor pointing to selector
  200.  *
  201.  * Output
  202.  *    InOut = selector PFO
  203.  */
  204. private boolean InSelector (F,InOut)
  205.    register InDesc *F;
  206.    ObjectPtr InOut;
  207.    {
  208.       register ListPtr P;
  209.       long Index = 0;
  210.  
  211.       do 
  212.      Index = 10*Index + (*F->InPtr++) - '0';
  213.       while isdigit (*F->InPtr);
  214.  
  215.       RepTag (InOut,LIST);
  216.       InOut->List = NIL;
  217.       NewList (&InOut->List,2L);
  218.       if (SysError) {
  219.      InOut->Tag = BOTTOM;
  220.      return 0;
  221.       }
  222.       P = InOut->List;
  223.       P->Val.Tag = NODE;
  224.       P->Val.Node = FormTable [NODE_Sel].FormNode;
  225.       P = P->Next;
  226.       P->Val.Tag = INT;
  227.       P->Val.Int = IsTok (F,"r") ? -Index : Index;
  228.       return 1;
  229.    }
  230.  
  231. /*
  232.  * InSimple
  233.  *
  234.  * Read a simple function
  235.  *
  236.  * Output
  237.  *      result = 1 iff error occurs, 0 otherwise
  238.  *      InOut = simple function if no error
  239.  *
  240.  * A SysError may occur, in which case InOut is unchanged.
  241.  */
  242. boolean InSimple (F,InOut,Env)
  243.    InDesc *F;
  244.    ObjectPtr InOut;
  245.    ListPtr Env;
  246.    {
  247.       static char InFirst[] = {     /* First characters of InPrefix */
  248.       'I','E','W','#','[','F','@'
  249. #if FETCH
  250.      ,'^'
  251. #endif
  252. #if XDEF
  253.      ,'{'
  254. #endif
  255.      ,'\0'
  256.       };
  257.       register FormEntry *K;
  258.       extern char *index ();
  259.  
  260.       if (Debug & DebugParse) {
  261.      printf ("InSimple: Env = "); OutList (Env); 
  262.      printf (", F = %s\n",F->InPtr);
  263.       } 
  264.       InBlanks (F);
  265. #if PATTERN
  266.       if (IsTok (F,"!")) return InObject (F,InOut);
  267. #endif
  268.       /* 
  269.        * The "index" lookup below quickly rejects strings which
  270.        * cannot be key words.
  271.        */
  272.       if (NULL != index (InFirst,*F->InPtr)) {
  273.      for (K=FormTable; K < ArrayEnd(FormTable); K++) 
  274.         if (*K->FormInPrefix != '\0' && IsTok (F,K->FormInPrefix))
  275.            return InPFO (F,InOut,K,Env);
  276.       } else
  277.      if (isdigit (*F->InPtr)) 
  278.         return InSelector (F,InOut);
  279.  
  280.       if (!InNode (F,InOut,Env)) 
  281.      return 0;
  282.       else if (InOut->List == NULL) 
  283.      return InError (F,"'/' not a function");
  284.       else
  285.      return 1;
  286.    }
  287.  
  288. /*
  289.  * InComp
  290.  *
  291.  * Input a composition
  292.  */
  293. boolean InComp (F,InOut,Env)
  294.    register InDesc *F;
  295.    ObjectPtr InOut;
  296.    ListPtr Env;
  297.    {
  298.       Object X;
  299.  
  300.       if (Debug & DebugParse) {
  301.      printf ("InComp: Env = "); 
  302.      OutList (Env); 
  303.      printf (", F = %s\n",F->InPtr);
  304.       }
  305.       X.Tag = BOTTOM;
  306.       if (!InSimple (F,&X,Env)) return 0;
  307.       else {
  308.      InBlanks (F);
  309.      if (!IsTok (F,"|")) {
  310.         RepObject (InOut,&X);
  311.         RepTag (&X,BOTTOM);
  312.         return !SysError;
  313.      } else {
  314.         ListPtr P,R=NIL; 
  315.         boolean Correct;
  316.         NewList (&R,1L);
  317.         if (SysError) Correct = 0;
  318.         else {
  319.            CopyObject (&(P=R)->Val,&X);
  320.            RepTag (&X,BOTTOM);
  321.            do {
  322.           NewList (&P->Next,1L);
  323.           Correct = !SysError && InSimple (F,&(P=P->Next)->Val,NIL);
  324.           InBlanks (F);
  325.            } while (Correct && IsTok (F,"|"));
  326.         }
  327.         return MakeForm (Correct,FormTable[NODE_Comp].FormNode,R,InOut);
  328.      }
  329.       }
  330.    }
  331.  
  332. /*
  333.  * InDef
  334.  *
  335.  * Input a function definition
  336.  *
  337.  * Input
  338.  *      FunName = Name of function
  339.  * Output
  340.  *      InOut = function definition
  341.  *      result = 1 iff successful, 0 otherwise
  342.  */
  343. boolean InDef (F,FunName,InOut)
  344.    register InDesc *F;
  345.    StrPtr FunName;
  346.    ObjectPtr InOut;
  347.    {
  348.       Object Fun,S;
  349.  
  350.       Fun.Tag = BOTTOM;
  351.       S.Tag = BOTTOM;
  352.       F->InFunName = FunName;
  353.  
  354.       InBlanks (F);
  355.       if (!IsTok (F,"DEF")) return InError (F,"DEF expected");
  356.       else {
  357.      (void) InString (F,&S,NodeDelim,0);
  358.      if (StrComp (S.String,FunName))
  359.         (void) InError (F,"Definition name wrong");
  360.      else {
  361.         InBlanks (F);
  362.         if (!IsTok (F,"AS")) (void) InError (F,"AS expected");
  363.         else 
  364.            if (InComp (F,&Fun,NIL)) {
  365.           InBlanks (F);
  366.           if (!IsTok (F,";")) (void) InError (F,"semicolon expected");
  367.           else 
  368.              if (*F->InPtr) (void) InError (F,"end of file expected");
  369.              else {
  370.             RepTag (&S,BOTTOM);
  371.             CopyObject (InOut,&Fun);
  372.             RepTag (&Fun,BOTTOM);
  373.             return 1;
  374.              }
  375.            }
  376.      }
  377.       }
  378.       RepTag (&S,BOTTOM);
  379.       RepTag (&Fun,BOTTOM);
  380.       return 0;
  381.    }
  382.  
  383.  
  384. /********************************** infun.c **********************************/
  385.  
  386.